perm filename INTERP.PA1[HAL,HE] blob
sn#196324 filedate 1976-01-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 .SBTTL Interpreter Data structures, INTINIT, MINTS
C00010 00003 Interpreter itself: INTERP
C00016 00004 GETARG, GETSCA, GETVEC, GETTRN
C00020 00005 Variable declaration: MVAR, KVAR
C00023 00006 Stack ops: GTVAL, IGTVAL, CHNGE, ICHNGE, PUSH, POP, COPY, REPLACE, FLUSH
C00028 00007 Global reference routines GLBLNK, GLOBSR.
C00033 00008 Flow-of-control: PROC, RETURN
C00039 00009 FORCHK, JUMP, JUMPC
C00042 00010 SPAWN, SPROUT, TERMINATE
C00050 00011 Calculator routines: MEXP, MCLC, DCLC, ENDCLC
C00055 00012 Changer routines: MCHGR, GTOLD, GTNEW
C00058 00013 return scalars: SADD, SSUB, SMUL, SDIV, SNEG, VDOT, PVDOT, VMAG, SSBRTN
C00065 00014 Vector utilities: UNITV, CROSV
C00071 00015 Return vectors: SVMUL, TVMUL, VMAKE, VADD
C00075 00016 Return a trans: TMAKE, TVADD, TTMUL, TINVRT
C00083 00017 Motion: MOVE, CENTER, STOP, WHERE
C00090 00018 Condition monitors: CMMAK
C00096 00019 CMENBL, CMDSBL, CMDEST, CMTRIG, CMSKED, CMUNCR
C00103 00020 Force condition monitors. Data structures. TABOFS, FMBLK, MAKFORCE, DESFORCE
C00111 00021 GETFORCE, MAKRT
C00118 00022 Events: MAKEVT, SIGNAL, WAITE, DESEVT
C00123 00023 Debugging aids: PRINT, PRNTS
C00127 00024 BREAK, NOOP, TOPAL, IOINIT
C00129 00025 Initialization psops: PROG
C00133 00026 BUGS
C00134 ENDMK
C⊗;
.SBTTL Interpreter ;Data structures, INTINIT, MINTS
COMMENT ⊗
Register uses in the interpreter:
R5 used by some routines as the display register
R4 points to interpreter status block
R3 interpreter stack pointer
R2 not used by the main interpreter loop. Can be munged by
any primary interpreter routine.
Each interpreter has a stack which it uses to store pointers to
currently "open" variables. During the course of a calculation,
operands and temporary result cells will be open in this fashion.
The "interpreter stack" is pointed to by R3. When a new interpreter
is sprouted, it is given a new stack area. Each interpreter has
certain status information which facilitates transfer of control
between interpreters. This information is kept in the interpreter
status block, which is always pointed to by R4. Most important are
the IPC, the Interpreter Program Counter, the ENV, which points to
the local environment, and LEV, which stores the current lexical
level.
Each procedure has an environment, which is a data area holding
information vital to that procedure. This includes pointers to all
the variables local to that procedure, and return information. ⊗
INSTSZ == 20 ;Size of an interpreter stack
;Interpreter status block
II == 0
XX IPC ;Interpreter program counter. Leave this as first field!
XX NXTINT ;Next interpreter in the list. For GC of the stacks.
XX STKBAS ;Location of start of stack area. Needed
;for eventual reclamation.
XX ENV ;Location of local environment
XX LEV ;Lexical level of current execution
XX STA ;Status bits for condition codes: 0 means all well.
XX PCB ;Location of process control block (for reclamation)
XX EVT ;The event to signal as this interpreter goes away
XX CMCB ;Pointer to c-m control block if this is a checker or a body
XX OLDV ;The "old value" used by changers
XX NEWV ;The "new value" used by changers
.IFNZ ALAID ;Special debugging information
XX DEBMOD ;The mode bits for debugging.
ALDSS == 1 ;1 => Single step mode
.ENDC
ISBS == II/2 ;Size (in words) of interpreter status block
;Fixed fields in the environment of each process
II == 0
XX SLINK ;Pointer to environment of next (outer, lower
; numbered) block
XX OLEV ;Old level. The lexical level of calling process.
XX OENV ;Old environment, the one for the calling process.
XX OIPC ;Old IPC. Program counter for calling process.
XX LVARS ;First location where pointers to local variables go
INTEVT: 0 ;The event that interlocks references to ISTBLK.
GLBEVT: 0 ;The event that interlocks references to GLBTAB.
INTINIT: ;Initializes the above events
EVMAK ;Initialize the INTEVT.
MOV (SP),INTEVT;
EVSIG ;
EVMAK ;Initialize the GLBEVT.
MOV (SP),GLBEVT ;
EVSIG ;
MOV #GLBTAB,GLBEND ;Initialize GLBEND. This wipes out all globals.
RTS PC ;Done
MINTS: ;Marking method for interpeter stacks
MOV R2,-(SP) ;Save R2
MOV R3,-(SP) ;Save R3
EVWAIT INTEVT ;Enter critical region
MOV NXTINT+ISTBLK,R2 ;R2 ← LOC[first real interpeter status block]
BEQ MINTS1 ;If none, then done
MINTS2: MOV STKBAS(R2),R3 ;R3 ← LOC[interpreter stack base]
ADD #2*INSTSZ,R3 ;R3 ← LOC[verge of new stack] (INSTSZ is in bytes)
MINTS4: MOV -(R3),R0 ;R0 ← stack entry
BEQ MINTS3 ;If 0, then end of stack (RF: this wont work!!)
JSR PC,MARKQ ;
MOV R0,(R3) ;Put it back (compactification may move it)
BR MINTS4 ;
MINTS3: MOV NXTINT(R2),R2 ;R2 ← LOC[next interpreter status block]
BNE MINTS2 ;Repeat as necessary
MINTS1: MOV (SP)+,R3 ;Restore R3
MOV (SP)+,R2 ;Restore R2
EVSIG INTEVT ;
RTS RF ;Return
;Interpreter itself: INTERP
.MACRO MAKEOP CNAME, ANAME ;Compiler name, Address name
XX CNAME
ANAME
.ENDM
;The interpreter operation table
INTOPS: MAKEOP XINVALID,INVALID ;Illegal instruction
.INSRT INTOPS.PAL[HAL,HE]
INSEND = II ;Marks the end of the instructions
.MACRO BMPIPC ;
ADD #2,IPC(R4) ;Bump IPC
.ENDM ;
.MACRO CCC ;Clear condition code
; CLR R0 ;Clear condition code. Not used right now.
.ENDM
.MACRO SCC ;Set condition code
; MOV #2,R0 ;Set condition code. Not used right now.
.ENDM
.IFZ ALAID ;The ALAID version is in ALAID.PAL
INTERP:
MOV R3,R0 ;Save the limit of the interpreter stack for error checking.
SUB #INSTSZ-2,R0
MOV R0,-(SP) ;
INT1: CMP R3,(SP) ;Interpreter stack overflow?
BGE INT3 ;No. Go to next instruction.
HALERR INTMS3 ;Yes. Complain.
INT3: MOV @IPC(R4),R0 ;R0 ← next instruction
BLE INVALID ;Instruction out of range
CMP R0,#INSEND ;Is instruction too large?
BLE INT2 ;No.
INVALID:HALERR INTMS1 ;Yes. complain.
INT2: BMPIPC ;Bump IPC
JSR PC,@INTOPS(R0) ;Call the appropriate routine
BR INT1 ;Repeat interpreter loop
INTMS1: ASCIE /INTERPRETER INSTRUCTION OUT OF RANGE/
INTMS2: ASCIE /INTERPRETED INSTRUCTION RETURNED FAILURE/
INTMS3: ASCIE /INTERPRETER STACK OVERFLOW/
.ENDC
; GETARG, GETSCA, GETVEC, GETTRN
GETARG:
COMMENT ⊗
Arguments:
R0=variable name: high byte is lexical level, low byte is offset.
R4=pointer to interpreter status block.
Result:
R0← pointer to address of desired variable.
R1 clobbered.
This routine returns in R0 a pointer to the location in the current
environment (or, if necessary, more global environment) which
points to the variable which is named in R0. ⊗
MOV R2,-(SP) ;Save R2
MOVB R0,R1 ;R1 ← Offset desired
CLRB R0 ;
SWAB R0 ;R0 ← Lexical level
MOV ENV(R4),R2 ;R2 ← LOC[local environment]
SUB LEV(R4),R0 ;R0 ← Difference in levels: desired-got
BEQ GTRG1 ;Diff=0; can use R2 as pointer at right base.
BHI GTERR ;If diff>0, then value inaccessible.
GTRG2: MOV SLINK(R2),R2;Must go up a level. R2 ← LOC[more global environment]
INC R0 ;R0 ← New difference in levels
BNE GTRG2 ;If not yet good, then move up another level
GTRG1: ADD R2,R1 ;R1 ← environment + offset = location of desired pointer
MOV (SP)+,R2 ;Restore R2.
MOV R1,R0 ;
RTS PC ;Done.
GTERR: HALERR GTMS1
GTMS1: ASCIE /ATTEMPT TO ACCESS UNAVAILABLE VARIABLE/
GETSCA: ;Gets place for a scalar result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
.IFNZ SMALLB
MOV #SCASPC,R0 ;
JSR PC,GETSBK ;Allocate from small blocks
.IFF
MOV #2,R0 ;Number of words needed
JSR PC,GTFREE ;R0 ← LOC[new block]
.ENDC
MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
RTS PC ;Done
GETVEC: ;Gets place for a vector result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
.IFNZ SMALLB
MOV #VCTSPC,R0 ;
JSR PC,GETSBK ;Allocate from small blocks
.IFF
MOV #10,R0 ;Number of words needed
JSR PC,GTFREE ;R0 ← LOC[new block]
.ENDC
MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
RTS PC ;Done
GETTRN: ;Gets place for a trans result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
.IFNZ SMALLB
MOV #TRNSPC,R0 ;
JSR PC,GETSBK ;Allocate from small blocks
.IFF
MOV #40,R0 ;Number of words needed
JSR PC,GTFREE ;R0 ← LOC[new block]
.ENDC
MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
RTS PC ;Done
;Variable declaration: MVAR, KVAR;
MVAR:
COMMENT ⊗ A list of arguments, each of which is an offset. This list
is terminated by a zero entry. For each argument, a fresh graph node
is created (with no value) and a pointer to it is placed in the
environment at the desired offset, current level. ⊗
MOV @IPC(R4),-(SP) ;push offset
BEQ MVAR1 ;If none, done
BMPIPC ;Bump IPC
CLR R0 ;The new graph node should get no value cell.
JSR PC,MAKEVN ;R0 ← LOC[a new variable node]
ADD ENV(R4),(SP);stack pointer into environment
MOV R0,@(SP)+ ;Point the environment to the graph node
BR MVAR ;Repeat
MVAR1: TST (SP)+ ;Clean off stack
BMPIPC ;Bump IPC
CCC ;Clear condition code.
RTS PC ;Done
KVAR:
COMMENT ⊗ A list of arguments, each of which is an offset. This list
is terminated by a zero entry. For each argument, the corresponding
graph node is destroyed in the current environment. Any function in
the graph structure is thereby released. (Attempt is made to
validate any dependents first.) ⊗
MOV @IPC(R4),R2 ;R2 ← offset
BEQ KVAR1 ;If none, done
BMPIPC ;Bump IPC
ADD ENV(R4),R2 ;R2 ← LOC[pointer at graph node]
MOV (R2),R0 ;R0 ← LOC[graph node]
JSR PC,DELVN ;Get this guy deleted
CLR (R2) ;Remove the pointer in the environment
BR KVAR ;Repeat
KVAR1: BMPIPC ;Bump IPC
CCC ;Clear condition code
RTS PC ;Done
;Stack ops: GTVAL, IGTVAL, CHNGE, ICHNGE, PUSH, POP, COPY, REPLACE, FLUSH
GTVAL:
COMMENT ⊗ The argument is a level-offset pair. The variable
referenced by that pair is examined and a pointer to its value cell
is placed on the stack. ⊗
MOV @IPC(R4),R0 ;Pick up level-offset name of argument
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[desired graph node]]
MOV (R0),R0 ;R0 ← LOC[desired graph node]
BEQ GTVL2 ;But if 0, then bug
GTVL4: CALL GETVAL,<R0>;R0 ← value
GTVL3: MOV R0,-(R3) ;Push value on interpreter stack.
BEQ GTVL1 ;But if 0, then bug
CCC ;Clear condition code.
RTS PC ;Done
GTVL1: HALERR GTVMS1 ;Complain
SCC ;Set condition code
RTS PC ;Done
GTVL2: HALERR GTVMS2 ;Complain
BR GTVL3 ;But comply
GTVMS1: ASCIE </GTVAL FOUND A NULL VALUE. MAY CONTINUE/>
GTVMS2: ASCIE </GTVAL FOUND A NULL GRAPH NODE. MAY CONTINUE/>
IGTVAL:
COMMENT ⊗ Immediate version of GTVAL. The argument points directly
to the graph node whose value is desired. A pointer to the value
cell is placed on the stack. ⊗
MOV @IPC(R4),R0 ;R0 ← LOC[desired graph node]
BMPIPC ;Bump IPC
CALL GETVAL,<R0>;R0 ← value
MOV R0,-(R3) ;Push value on interpreter stack.
CCC ;Clear condition code.
RTS PC ;Done
CHNGE:
COMMENT ⊗ Pops the value from top of stack into the graph structure
pointed to by the level-offset pair given in the argument. ⊗
MOV @IPC(R4),R0 ;Pick up level-offset name of argument
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[Desired graph node]]
MOV (R0),R0 ;R0 ← LOC[Desired graph node]
BEQ CHNGE1 ;If any
CHNGE2: CALL CHANGE,<R0,(R3)>
POP: TST (R3)+ ;Pop stack
CCC ;Clear condition code.
RTS PC ;Done
CHNGE1: HALERR CHNMES ;Complain
TST (R3)+ ;Get rid of the value
SCC ;Set condition code
RTS PC ;Done
CHNMES: ASCIE </CAN'T ASSIGN INTO UNINITIALIZED VARIABLE/>
ICHNGE:
COMMENT ⊗ Immediate version of CHNGE. Pops the value from top of
stack into the graph structure pointed to directly by the argument. ⊗
MOV @IPC(R4),R0 ;R0 ← LOC[desired graph node]
BMPIPC ;Bump IPC
CALL CHANGE,<R0,(R3)>
TST (R3)+ ;Pop stack
CCC ;Clear condition code.
RTS PC ;Done
PUSH: MOV @IPC(R4),-(R3);Put argument directly on stack
BMPIPC ;Bump IPC
CCC ;Clear condition code.
RTS PC ;Done
; Interpreter routine. Copies the nth element in stack to the top,
; where the curent top is 0.
COPY: MOV @IPC(R4),R0 ;Pick up argument.
BMPIPC ;Bump IPC
ADD R0,R0 ;Double R0 to make it in bytes
ADD R3,R0 ;R0 ← LOC[stack element to be copied to top]
MOV (R0),-(R3) ;Copy it onto top of stack.
CCC ;Clear condition code.
RTS PC ;Done
REPLAC: MOV @IPC(R4),R0 ;Pick up argument.
BMPIPC ;Bump IPC
ADD R0,R0 ;Double R0 to make it in bytes
ADD R3,R0 ;R0 ← LOC[stack element to be copied into]
MOV (R3)+,(R0) ;Copy verge of stack into it.
CCC ;Clear condition code.
RTS PC ;Done
FLUSH: MOV STKBAS(R4),R3;Reset the stack base.
CCC ;Clear condition code.
RTS PC ;Done
;Global reference routines GLBLNK, GLOBSR.
GLBLNK: ;Interpreter routine
COMMENT ⊗ Expects two arguments at the IPC, a level-offset, and two
words of a Rad50 name. Makes sure that this global is linked in to
the environment at the given level-offset. If not, a search is
made for it, and the result is put in the environment.
⊗
MOV @IPC(R4),R0 ;R0 ← level-offset
BMPIPC ;Bump IPC past the level-offset
JSR PC,GETARG ;R0 ← LOC[environment cell]
TST (R0) ;Graph node yet?
BEQ GLOBG1 ;No, must search for it
GLOBG2: BMPIPC ;Bump IPC past the Rad50 name
BMPIPC ;Bump IPC past the Rad50 name
RTS PC ;Done
GLOBG1: MOV R0,R2 ;R2 ← LOC[environment cell]
MOV IPC(R4),R0 ;R0 ← LOC[Rad50 representation]
JSR PC,GLOBSR ;R0 ← LOC[new or old graph node]
MOV R0,(R2) ;Stow LOC[graph node] in the environment cell
BR GLOBG2 ;Ready to return
MAXGLB == 10 ;Maximum number of globals allowed
GLBTAB: .BLKW 3*MAXGLB ;Three words per global: 2 of Rad50, one
;pointer to the graph node.
;To be searched linearly.
GLBLIM: .BLKW 3 ;Overflow place for GLBTAB
GLBEND: .BLKW 1 ;Points to next free place in GLBTAB
GLOBSR:
COMMENT ⊗ R0 = LOC[two words of Rad50]. Tries to find the
appropriate graph node using the GLBTAB, and if it fails, makes a new
graph node and inserts it in the GLBTAB. In any case, returns R0 ←
LOC[new or old graph node]. ⊗
EVWAIT GLBEVT ;Critical region starts here
MOV GLBEND,R1 ;R1 ← LOC[next free place in GLBTAB]
MOV (R0),(R1)+ ;Put the word sought at next free place
MOV 2(R0),(R1)+ ;
CLR (R1) ; with a 0 for a graph node pointer.
MOV #GLBTAB,R1 ;R1 ← LOC[start of GLBTAB]
GLOBS3: CMP (R0),(R1) ;MATCH?
BNE GLOBS1 ;No.
CMP 2(R0),2(R1) ;Second word match?
BEQ GLOBS2 ;Yes.
GLOBS1: ADD #6,R1 ;
BR GLOBS3 ;Try again.
GLOBS2: MOV 4(R1),R0 ;R0 ← LOC[graph node]
BNE GLOBS6 ;If it is not zero, we are done
ADD #6,GLBEND ;Move the end of the table down one entry
CMP GLBEND,#GLBLIM ;Too far?
BLT GLOBS5 ;No
HALERR GLOBMS ;Yes
GLOBS5: MOV R1,-(SP) ;Save place in GLBTAB
CLR R0 ;New graph node should have no value cell.
JSR PC,MAKEVN ;R0 ← LOC[a new variable node]
MOV (SP)+,R1 ;Restore place in GLBTAB
MOV R0,4(R1) ;store LOC[new graph node] in GLBTAB
GLOBS6: EVSIG GLBEVT ;Critical region ends here
RTS PC ;Done
GLOBMS: ASCIE </TOO MANY GLOBALS/>
;Flow-of-control: PROC, RETURN
PROC:
;Procedure call. Arguments:
; Destination.
; List of variables which are to be inserted in appropriate
; locations in the local storage of procedure. These are
; in the format variable (ie level-offset pair), new offset
; (right justified in the second word).
; There is a zero word to finish these.
;At the destination address can be found:
II == 0
XX FSLGTH ;Number of words to get from free storage
;for local variable pointers
XX PLEV ;Lexical level of procedure
DSLGTH == II ;Number of words before code starts
;Value parameters should have first been copied first into local temps
; (which have been arranged by the compiler), and then the temps are
; passed by reference. Eventual problem: to know which variables to
; really kill as the procedure is exited.
MOV @IPC(R4),R2 ;R2 ← LOC[destination]
BMPIPC ;Bump IPC
MOV FSLGTH(R2),R0 ;R0 ← Number of words to get.
JSR PC,GTFREE ;R0 ← LOC[block with that number of words]
;initialize pointer to lexical level:
MOV PLEV(R2),R1 ;R1 ← Lexical level of procedure
MOV ENV(R4),R2 ;R2 ← LOC[current environment]
SUB LEV(R4),R1 ;R1 ← Difference in levels: desired-got
BEQ PRC1 ;Diff=0; can use R2 as pointer at right environment.
PRC2: MOV SLINK(R2),R2;No, must go up a level. R2 ← LOC[base of upper area]
INC R1 ;R1 ← New difference in levels
BNE PRC2 ;If not yet good, then move up another level
PRC1: MOV R2,SLINK(R0);SLINK[new environment] ← correct global environment
;Put copies of local variables in new area
MOV R0,-(SP) ;Stack LOC[new environment]
MOV @IPC(R4),R0 ;R0 ← level-offset pair for an argument
BEQ PRC3 ;If there are no more, go to next phase
PRC4: BMPIPC ;Else bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[graph node]]
MOV @IPC(R4),R1 ;R1 ← offset in new block
BMPIPC ;Bump IPC
ADD (SP),R1 ;R1 ← LOC[place in new environment to put pointer]
MOV (R0),(R1) ;new environment gets pointer to LOC[argument graph node]
MOV @IPC(R4),R0 ;R0 ← level-offset pair for an argument
BNE PRC4 ;If there are more, go back and treat them
PRC3: BMPIPC ;Bump IPC one last time
;Save the old context in the new area
MOV (SP)+,R1 ;R1 ← LOC[new environment]
MOV LEV(R4),OLEV(R1) ;Store the old level
MOV ENV(R4),OENV(R1) ;Store the old environment location
MOV IPC(R4),OIPC(R1) ;Store the return address
;Set up the new context for procedure
MOV PLEV(R2),LEV(R4) ;New lexical level
MOV R1,ENV(R4) ;New environment location
ADD #DSLGTH,R2 ;R2 ← Place where execution should begin
MOV R2,IPC(R4) ;New program counter
CCC ;Clear condition code.
RTS PC ;Done
RETURN:
;Returns from a procedure call to calling program. Since variables are
;passed by reference, it is not necessary to do any copying of values.
;All that is needed is to restore the context of the caller and to
;discard the display.
MOV ENV(R4),R0 ;R0 ← LOC[current environment]
MOV OLEV(R0),LEV(R4) ;Restore the old lexical level
MOV OENV(R0),ENV(R4) ;Restore the old environment
MOV OIPC(R0),IPC(R4) ;Restore the IPC
JSR PC,RLFREE ;Release storage of old display
CCC ;Clear condition code.
RTS PC ;Done
; FORCHK, JUMP, JUMPC
FORCHK:
;Assume that the stack has, from surface in, the increment, the
; final value, and the control variable's value, all of which are
; scalar values. If (FINAL-CONVAR)*(INCREMENT) ≥ 0 then this is a
; no-op; otherwise, jump to the destination.
;Arguments: destination.
LDF @2(R3),AC0 ;AC0 ← final value
SUBF @4(R3),AC0 ;AC0 ← final - current
MULF @(R3),AC0 ;AC0 ← (final - current)*increment
MOV @IPC(R4),R0 ;R0 ← destination
BMPIPC ;Bump IPC
CFCC ;
BGE FOR1 ;Shall this be a no-op?
MOV R0,IPC(R4) ;No; set new IPC.
FOR1: CLR R0 ;
RTS PC ;Done
JUMP:
;Takes one argument: the new address.
MOV @IPC(R4),IPC(R4)
CCC ;Clear condition code.
RTS PC ;Done
JUMPC: ;Interpreter routine
COMMENT ⊗ Two arguments: the condition and the destination address.
The condition queries the top of the stack and pops it, assuming it
to be a scalar. The interpreter jumps to the destination address if
the condition is satisfied. The possible conditions are 0(Never),
1(L), 2(E), 3(LE), 4(Always), 5(GE), 6(NE), 7(G). Note that
comparisons of equality must be exact to floating precision. ⊗
MOV @IPC(R4),R2 ;R2 ← condition
BMPIPC ;Bump IPC
BLT JMPCERR ;If out of range, complain.
MOV R2,R0 ;
SUB #7,R0 ;
BGT JMPCERR ;
MOV (R3)+,R0 ;R0 ← LOC[arg]
LDF (R0),AC0 ;AC0 ← arg
ADD R2,R2 ;
ADD R2,R2 ;Multiply condition by 4.
CFCC ;
JMP JMPC3(R2) ;Go to the right test.
JMPC3: BR JMPC1 ;N always fail
BR JMPC4 ;
BGE JMPC1 ;L
BR JMPC4 ;
BNE JMPC1 ;E
BR JMPC4 ;
BGT JMPC1 ;LE
BR JMPC4 ;
TST R0 ;A never fail
BR JMPC4 ;
BLT JMPC1 ;GE
BR JMPC4 ;
BEQ JMPC1 ;NE
BR JMPC4 ;
BLE JMPC1 ;G
JMPC4: MOV @IPC(R4),IPC(R4) ;Succeed
BR JMPC2 ;
JMPC1: BMPIPC ;Fail. Bump IPC
JMPC2: CCC ;Clear condition code.
RTS PC ;Done
JMPCER: HALERR JMPCMS ;
JMPCMS: ASCIE </ILLEGAL JUMPC CODE/>
; SPAWN, SPROUT, TERMINATE
SPAWN: ;Utility routine
COMMENT ⊗ Takes two arguments: In R0, the IPC of the interpreter to
spawn, and in R1, the event (if any) to put in EVT of the new
interpreter. The inferior will have the same environment as the
superior. Creates an interpreter status block, stack, process
descriptor, and is ready for a SCHEDU when it returns the process
descriptor in R0. ⊗
MOV R1,-(SP) ;Save the EVT
MOV R0,-(SP) ;Save the new IPC
MOV #ISBS,R0 ;R0 ← Size (in words) of an interpreter status block
JSR PC,GTFREE ;R0 ← LOC[new interpreter status block]
MOV (SP)+,IPC(R0);new IPC ← first argument
MOV ENV(R4),ENV(R0) ;new ENV ← old ENV
MOV LEV(R4),LEV(R0) ;new LEV ← old LEV
.IFNZ ALAID
MOV DEBMOD(R4),DEBMOD(R0) ;new DEBMOD ← old DEBMOD
.ENDC
EVWAIT INTEVT ;Interlock sensitive operation.
MOV #NXTINT+ISTBLK,R1 ;Link into the interpreter list.
MOV (R1),NXTINT(R0) ;
MOV R0,(R1) ;
EVSIG INTEVT ;End of interlock
MOV (SP)+,EVT(R0);new EVT ← second argument.
MOV R0,-(SP) ;Save LOC[new interpreter status block]
MOV #INSTSZ,R0 ;R0 ← Size needed for an interpreter stack
JSR PC,GTFREE ;R0 ← LOC[new interpreter stack]
MOV (SP)+,R1 ;R1 ← LOC[new interpreter status block]
MOV R0,STKBAS(R1) ;Store away new stack base
ADD #2*INSTSZ,R0 ;R0 ← LOC[top of new stack] (INSTSZ is in bytes)
MOV R1,-(SP) ;Save R1
MOV R0,-(SP) ;Save R0
MOV #210,R0 ;Room for process descriptor
JSR PC,GTFREE ;R0 ← LOC[new process descriptor]
MOV #UFPUSE+UGRSAV,PDBSTA(R0);Use floating point, use saved registers.
MOV #420,UPDLEN(R0) ;Length of PCB
; MOV (R2),PDBR2(R0) ;Transfer register 2 (not currently necessary)
MOV (SP)+,R1 ;R1 ← LOC[new interpreter stack top]
MOV R1,PDBR3(R0) ;Store away new interp stack pointer (reg 3)
MOV (SP)+,R1 ;R1 ← LOC[new ISB]
MOV R0,PCB(R1) ;Store away LOC[PCB] in new ISB
MOV R1,PDBR4(R0) ;Store away LOC[ISB] in reg 4 of PCB
; MOV R5,PDBR5(R0) ;Store away reg 5 (not currently necessary)
MOV SP,R1 ;
TST (R1)+ ;
MOV R1,PDBSP(R0) ;Store away the new stack pointer (reg 6)
MOV #INTERP,PDBPC(R0);Store away the new PC
.IFNZ K2
MOV PCB(R4),R1 ;Use same UIMAP, UDMAP that we are using.
MOV UIMAP(R1),UIMAP(R0) ;
MOV UDMAP(R1),UDMAP(R0) ;
.ENDC
RTS PC ;Done
; These are the appropriate scheduling commands:
; SCHEDU R0,#INTERP,#0,#2;Cause the new process to be started, suspended
; FORK R0,#INTERP,#0 ;Cause the new process to be started.
SPROUT: ;Interpreter routine
COMMENT ⊗ Arguments: One address in pseudo-code for each of the
several forks starting up, followed by a 0 word. This is to be used
only for cobegins, not for servos. Each new interpreter is given an
interpreter status block and is then scheduled. As each terminates,
it signals its defining event. Since each of these has the same
event, the current interpreter need only wait until they all happen.
⊗
MOV R3,-(SP) ;Save R3. Caution: cannot use interpreter stack now.
CLR R3 ;R3 is the count of how many inferiors to spawn.
EVMAK ;-(SP) ← Event identifier for communication with infs.
SPR2: MOV @IPC(R4),R0 ;R0 ← next argument (IPC)
BEQ SPR1 ;If zero, then we have spawned all the inferiors.
BMPIPC ;Bump IPC
INC R3 ;Count it.
MOV (SP),R1 ;R1 ← event for the inferior EVT
JSR PC,SPAWN ;R0 ← process control block of new interpreter
SCHEDU R0,#INTERP,#0,#2;Cause the new process to be started, suspended
BR SPR2 ;Go handle the next inferior.
SPR1: BMPIPC ;Bump IPC
SPR4: DEC R3 ;Another wait to be done?
BMI SPR3 ;No, we are finished.
EVWAIT (SP) ;Wait for an inferior to come back.
BCC SPR4 ;If all well, wait for the next one.
HALERR SPRMES ;The event was killed!
SPR3: EVKIL (SP)+ ;Kill the event now, remove from stack
MOV (SP)+,R3 ;Restore R3
CCC ;Clear condition code.
RTS PC ;Done
SPRMES: ASCIE /BAD RETURN FROM INFERIOR/
TERMINATE:
COMMENT ⊗ Interpreter routine, sometimes jumped to from other
interpreter routines. End this interpreter. ⊗
MOV EVT(R4),R0 ;R0 ← event to announce imminent demise
BEQ TERM1 ;If there is one
EVSIG R0 ;Announce that we are about to disappear.
TERM1: MOV STKBAS(R4),R0 ;Reclaim interpreter stack
JSR PC,RLFREE ;
MOV PCB(R4),R0 ;Reclaim process control block (may be dangerous)
JSR PC,RLFREE ;
MOV R4,R0 ;Reclaim Interpreter Status Block
JSR PC,RLFREE ;
EVWAIT INTEVT ;Enter critical region.
MOV #ISTBLK,R0 ;The following unlinks this interpreter from the chain.
TERM3: MOV R0,R1 ;
MOV NXTINT(R1),R0;
CMP R0,R4 ;Have we found ours yet?
BNE TERM3 ;
MOV NXTINT(R4),NXTINT(R1); Yes. rechain.
EVSIG INTEVT ;Leave critical region.
DISMIS ;Go away
;Calculator routines: MEXP, MCLC, DCLC, ENDCLC;
COMMENT ⊗ Make an expression, put it in enviroment. Arguments are
the needed list (level-offset list, terminated by 0), the IPC
(ablsolute address), and the level-offset. ⊗
MEXP: ;Interpreter routine.
;form the needed list
CLR -(SP) ;Start with null needed list on the stack
MEXP1: MOV @IPC(R4),R0 ;R0 ← the next needed level-offset
BEQ MEXP2 ;Any more?
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[next needed graph node]]
MOV (R0),-(SP) ;Stack next needed graph node
JSR PC,NEWCEL ;R0 ← LOC[new cell]
MOV (SP)+,CAR(R0) ;LOC[Needed graph node]
MOV (SP),CDR(R0);Link to rest of needed list
MOV R0,(SP) ;New needed list
BR MEXP1 ;Repeat
MEXP2: BMPIPC ;Bump IPC past the 0 at end of list
MOV (SP)+,R0 ;R0 ← needed list
MOV @IPC(R4),R1 ;R1 ← IPC
BMPIPC ;Bump IPC
CALL MAKEXP,<R4,R1,R0> ;R0 ← LOC[new expression node]
MOV @IPC(R4),R1 ;R1 ← offset
BMPIPC ;Bump IPC
ADD ENV(R4),R1 ;R0 ← Pointer into environment
MOV R0,(R1) ;Stow away pointer to expression node
CCC ;Clear condition code
RTS PC ;Done
MCLC: ;Interpreter routine.
COMMENT ⊗ Takes two arguments: the level-offset of the expression,
and the level-offset of the variable for which this expression is to
be a calculator. ⊗
MOV @IPC(R4),R0 ;R0 ← Level-offset of expression
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[exression node]]
MOV (R0),R2 ;R2 ← LOC[expression node]
MOV @IPC(R4),R0 ;R0 ← level-offset of variable
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[variable node]]
CALL ADDCLC,<(R0),R2> ;Do the linking
CCC ;Clear condition code
RTS PC ;Done
DCLC: ;Interpreter routine
COMMENT ⊗ Takes two arguments: the level-offset of the expression,
and the level-offset of the variable from which this expression is to
be removed as a calculator. ⊗
MOV @IPC(R4),R0 ;R0 ← Level-offset of expression
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[exression node]]
MOV (R0),R2 ;R2 ← LOC[expression node]
MOV @IPC(R4),R0 ;R0 ← level-offset of variable
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[variable node]]
CALL REMCLC,<(R0),R2> ;Do the unlinking
CCC ;Clear condition code
RTS PC ;Done
ENDCLC: ;Interpreter routine.
COMMENT ⊗ Called as last instruction in a calculator cell. Returns
via an RTS RF with the value from the top of the stack in R0. Does
not unlink anything. ⊗
MOV RF,SP ;Reset the stack
TST -(SP) ;
MOV (R3)+,R0 ;Get the coveted value cell
RTS RF ;Will return to the calling point in EVLCLC.
;Changer routines: MCHGR, GTOLD, GTNEW
COMMENT ⊗ Make a changer for a graph node. This involves several
data: the target variable, specified as a level-offset pair, and the
location of the changer code, (which is ordinary interpreter code
which terminates with TERMINATE). These data are passed as arguments
to MCHG: target (level-offset), IPC (absolute address). Recall that
a changer cell looks like this:
II==0
XX NXTCHG ;next changer cell in chain
XX CHGISB ;Points to interpreter status block to resolve addressing
XX CHGIPC ;the interpeter PC where the calculation starts
CHGCSZ == II/2 ;Size of changer cell, in words
⊗
MCHG: ;Interpreter routine.
MOV R2,-(SP) ;Save R2
MOV R3,-(SP) ;Save R3
MOV #CHGCSZ,R0 ;Get room for a changer cell
JSR PC,GTFREE ;Note that we use large block allocation
MOV R0,R3 ;R3 ← LOC[new changer cell]
MOV R4,CHGISB(R3) ;store away ISB
MOV @IPC(R4),R0 ;R0 ← level-offset pair.
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[target graph node]]
MOV (R0),R2 ;R2 ← LOC[target graph node]
MOV @IPC(R4),CHGIPC(R3) ;store away target IPC
BMPIPC ;Bump IPC
CALL ADDCHG,<R2,R3> ;Do the final linking
MOV (SP)+,R3 ;Restore R3
MOV (SP)+,R2 ;Restore R2
CCC ;Clear condition code
RTS PC ;Done
GTOLD: ;Interpreter routine
COMMENT ⊗ Gets the OLD value that this changer (acting as an
interpreter) has access to; puts it on the stack. ⊗
MOV OLDV(R4),-(R3)
CCC ;Clear condition code
RTS PC ;Done
GTNEW: ;Interpreter routine
COMMENT ⊗ Gets the NEW value that this changer (acting as an
interpreter) has access to; puts it on the stack. ⊗
MOV NEWV(R4),-(R3)
CCC ;Clear condition code
RTS PC ;Done
;return scalars: SADD, SSUB, SMUL, SDIV, SNEG, VDOT, PVDOT, VMAG, SSBRTN
COMMENT ⊗ All timings are averages of 1000 runs. They take into
account the cost of the RTS but not the JSR. It is assumed that
GETSCA and GETVEC take no time. All routines on this page are
interpreter routines. ⊗
;30 microseconds
SADD: ;Scalar ← Scalar + Scalar
LDF @(R3)+,AC0 ;AC0 ← arg 2
ADDF @(R3)+,AC0 ;AC0 ← arg2 + arg1
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
SSUB: ;Scalar ← Scalar - Scalar
LDF @2(R3),AC0 ;AC0 ← arg 1
SUBF @(R3)+,AC0 ;AC0 ← arg1 - arg2
TST (R3)+ ;Move past first argument
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
;30 microseconds
SMUL: ;Scalar ← scalar * scalar
LDF @(R3)+,AC0 ;AC0 ← arg 2
MULF @(R3)+,AC0 ;AC0 ← arg2 * arg1
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
;33 microseconds
SDIV: ;Scalar ← Scalar / Scalar
LDF @(R3)+,AC1 ;AC1 ← arg 2
LDF @(R3)+,AC0 ;AC0 ← arg 1
DIVF AC1,AC0 ;AC0 ← arg1 / arg2
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
;26 microseconds
SNEG: ;Scalar ← -Scalar
LDF @(R3)+,AC0 ;AC0 ← arg
NEGF AC0 ;AC0 ← -arg
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
;96 -- 116 microseconds
VDOT: ;Scalar ← Vector dot Vector
;S ← (X1X2 + Y1Y2 + Z1Z2) / W1W2
MOV R2,-(SP) ;Save R2.
MOV (R3)+,R1 ;R1 ← LOC[arg 2]
MOV (R3)+,R0 ;R0 ← LOC[arg 1]
CLRF AC0 ;AC0 ← 0. Running total
MOV #3,R2 ;R2 ← 3: Length of vector
VDV1: LDF (R0)+,AC1 ;Form sum of products of first 3 terms
MULF (R1)+,AC1 ;
ADDF AC1,AC0 ;
SOB R2,VDV1 ;Loop until all 3 fields done.
DIVF (R0),AC0 ;Divide by W1
DIVF (R1),AC0 ;Divide by W2. AC0 now has answer.
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
MOV (SP)+,R2 ;Restore R2
CCC ;Clear condition code.
RTS PC ;Done
;103 -- 116 microseconds
PVDOT: ;Scalar ← Plane dot Vector
;S ← X1X2 + Y1Y2 + Z1Z2 + W1W2
MOV R2,-(SP) ;Save R2.
MOV (R3)+,R1 ;R1 ← LOC[arg 2]
MOV (R3)+,R0 ;R0 ← LOC[arg 1]
CLRF AC0 ;AC0 ← 0. Running total
MOV #4,R2 ;R2 ← 4: Length of vector and weight
PDV1: LDF (R0)+,AC1 ;Form sum of products of all 4 terms
MULF (R1)+,AC1 ;
ADDF AC1,AC0 ;
SOB R2,PDV1 ;Loop until all 3 fields done.
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
MOV (SP)+,R2 ;Restore R2
CCC ;Clear condition code.
RTS PC ;Done
;199 -- 207 microseconds
VMAGN: ;Scalar ← Norm (vector)
;S ← SQRT(XX + YY+ ZZ) / W
MOV (R3)+,R1 ;R1 ← LOC[arg]
LDF (R1)+,AC0 ;AC0 ← X
MULF AC0,AC0 ;AC0 ← XX
LDF (R1)+,AC1 ;AC1 ← Y
MULF AC1,AC1 ;AC1 ← YY
ADDF AC1,AC0 ;AC0 ← XX + YY
LDF (R1)+,AC1 ;AC1 ← Z
MULF AC1,AC1 ;AC1 ← ZZ
ADDF AC1,AC0 ;AC0 ← XX + YY + ZZ
MOV R1,-(SP) ;Push LOC[W] onto system stack, to save across SQRTF
JSR PC,@LSQRTF ;AC0 ← SQRT(XX + YY + ZZ)
DIVF @(SP)+,AC0 ;AC0 ← AC0 / W
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store answer
CCC ;Clear condition code.
RTS PC ;Done
SSBRTN: ;Call a routine.
MOV (R3)+,R1 ;R1 ← LOC[arg]
LDF (R1),AC0 ;AC0 ← arg
MOV @IPC(R4),R0 ;R0 ← which routine (a small number)
BMPIPC ;Bump IPC
ASL R0 ;Double (words → bytes)
BLE SSBRT1 ;Too small.
CMP R0,#SBLSIZ ;Too large?
BGE SSBRT1 ;Yes
JSR PC,@SBRLST(R0) ;Call a routine. AC0 ← answer.
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store answer
CCC ;Clear condition code.
RTS PC ;Done
SSBRT1: HALERR SSBRMS ;Complain
SCC ;Set condition code
RTS PC ;Done
SSBRMS: ASCIE </NO SUCH SUBROUTINE/>
SBRLST: ;List of legal subroutines
0 ;Illegal
SQRT ;The only one right now. #1
SBLSIZ == .-SBRLST ;The size of the list (bytes)
SQRT: JMP @LSQRTF ;Let it do the returning
;Vector utilities: UNITV, CROSV
COMMENT ⊗ These are not currently being used
;281 -- 286 microseconds
UNITV: ;Vector ← V / Norm(V)
;S ← SQRT(XX + YY+ ZZ) / W
MOV (R3),R1 ;R1 ← LOC[arg]
LDF (R1)+,AC0 ;AC0 ← X
MULF AC0,AC0 ;AC0 ← XX
LDF (R1)+,AC1 ;AC1 ← Y
MULF AC1,AC1 ;AC1 ← YY
ADDF AC1,AC0 ;AC0 ← XX + YY
LDF (R1)+,AC1 ;AC1 ← Z
MULF AC1,AC1 ;AC1 ← ZZ
ADDF AC1,AC0 ;AC0 ← XX + YY + ZZ
MOV R1,-(SP) ;Save R1 across SQRTF
JSR PC,SQRTF ;AC0 ← SQRT(XX + YY + ZZ)
MOV (SP)+,R1 ;Restore R1
DIVF (R1),AC0 ;AC0 ← Norm = SQRT / W
MOV (R3)+,R1 ;R1 ← LOC[arg]
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV #3,R2 ;R2 ← count of fields
UNITV1: LDF (R1)+,AC1 ;AC1 ← field of vector
DIVF AC0,AC1 ;divide by norm
STF AC1,(R0)+ ;Store result
SOB R2,UNITV1 ;Loop until done
MOV (R1)+,(R0)+ ;Copy W.
MOV (R1),(R0) ; (two words long)
CCC ;Clear condition code
RTS PC ;Done
;172 -- 184 microseconds
CROSV: ;Vector ← Vector cross Vector
;X ← Y1Z2 - Y2Z1
;Y ← X2Z1 - X1Z2
;Z ← X1Y2 - X2Y1
;W ← W1W2
;AC0, 1, 2, 3, 4, 5 are garbaged by this routine.
MOV (R3),R2 ;R2 ← LOC[arg 2]
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV 4(R3),R1 ;R1 ← LOC[arg 1]. Must not pop R3 stack yet!
LDF 14(R1),AC0 ;AC0 ← W1
MULF 14(R2),AC0 ;AC0 ← W1W2
STF AC0,14(R0) ;Store AC0 → W
LDF 4(R1),AC0 ;AC0 ← Y1
LDF (R2),AC1 ;AC1 ← X2
LDF 4(R2),AC2 ;AC2 ← Y2
LDF (R1),AC3 ;AC3 ← X1
STF AC3,AC4 ;AC4 ← X1
STF AC0,AC5 ;AC5 ← Y1
MULF AC2,AC3 ;AC3 ← X1Y2
MULF AC1,AC0 ;AC0 ← X2Y1
SUBF AC0,AC3 ;AC3 ← X1Y2 - X2Y1
STF AC3,10(R0) ;Z ← AC3
LDF 10(R2),AC0 ;AC0 ← Z2
LDF 10(R1),AC3 ;AC3 ← Z1
MULF AC4,AC0 ;AC0 ← X1Z2
MULF AC3,AC1 ;AC1 ← X2Z1
SUBF AC0,AC1 ;AC1 ← X2Z1 - X1Z2
STF AC1,4(R0) ;Y ← AC1
LDF 10(R2),AC0 ;AC0 ← Z2
MULF AC5,AC0 ;AC0 ← Y1Z2
MULF AC2,AC3 ;AC3 ← Y2Z1
SUBF AC3,AC0 ;AC0 ← Y1Z2 - Y2Z1
STF AC0,(R0) ;X ← AC0
MOV (R3)+,2(R3) ;Put result cell where first argument was
TST (R3)+ ;Put stack pointer in right place
CCC ;Clear condition code
RTS PC ;Done
⊗ END OF COMMENTED-OUT PROCEDURES.
;Return vectors: SVMUL, TVMUL, VMAKE, VADD
;83 -- 91 microseconds
SVMUL: ;Vector ← Scalar * Vector. Interpreter routine
;X ← S*X, Y ← S*Y, Z ← S*Z, W ← W
MOV (R3)+,R2 ;R2 ← LOC[vector]
LDF @(R3)+,AC0 ;AC0 ← scalar;
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV #3,R1 ;R1 ← 3: How many fields to handle
SVM1: LDF (R2)+,AC1 ;AC1 ← next field of vector
MULF AC0,AC1 ;AC1 ← product
STF AC1,(R0)+ ;Store result
SOB R1,SVM1 ;Loop until all 3 fields done.
MOV (R2)+,(R0)+ ;Transfer W
MOV (R2)+,(R0)+ ; which is 2 words long.
CCC ;Clear condition code
RTS PC ;Done
VMAKE: ;Interpreter routine
LDF @(R3)+,AC1 ;Fetch X
LDF @(R3)+,AC2 ;Fetch Y
LDF @(R3)+,AC3 ;Fetch Z
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
STF AC1,(R0)+ ;Store X
STF AC2,(R0)+ ;Store Y
STF AC3,(R0)+ ;Store Z
MOV ONE,(R0)+ ;Store W
CLR (R0) ;Store W (second word)
CCC ;Clear condition code
RTS PC ;Done
VADD: ;Interpreter routine
MOV (R3)+,R0 ;R0 ← LOC[arg 1]
MOV (R3)+,R1 ;R1 ← LOC[arg 1]
LDF (R0)+,AC1 ;Calculate X
ADDF (R1)+,AC1 ;
LDF (R0)+,AC2 ;Calculate Y
ADDF (R1)+,AC2 ;
LDF (R0)+,AC3 ;Calculate Z
ADDF (R1)+,AC3 ;
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
STF AC1,(R0)+ ;Store X
STF AC2,(R0)+ ;Store Y
STF AC3,(R0)+ ;Store Z
MOV ONE,(R0)+ ;Assume W is 1
CLR (R0) ;
CCC ;Clear condition code
RTS PC ;Done
;283 -- 324 microseconds
TVMUL: ;Vector ← Trans * Vector. Interpreter routine
MOV (R3),R2 ;R2 ← LOC[vector]
MOV 2(R3),R0 ;R0 ← LOC[trans]
CLRF AC1 ;X ← 0
CLRF AC2 ;Y ← 0
CLRF AC3 ;Z ← 0
MOV #4,R1 ;R1 ← How many columns left to go
TVM1: LDF (R2)+,AC0 ;AC0 ← field of vector
STF AC0,AC5 ;AC5 ← copy of AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC1 ;Add partial result to X
LDF AC5,AC0 ;Restore AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC2 ;Add partial result to Y
LDF AC5,AC0 ;Restore AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC3 ;Add partial result to Z.
ADD #4,R0 ;Skip bottom row
SOB R1,TVM1 ;Go back to do all 4 columns.
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
STF AC1,(R0)+ ;Store X
STF AC2,(R0)+ ;Store Y
STF AC3,(R0)+ ;Store Z
MOV -4(R2),(R0)+;Copy W from the vector
MOV -2(R2),(R0) ; (2 words long)
MOV (R3)+,2(R3) ;Put result cell where first argument was
TST (R3)+ ;Put stack pointer in right place
CCC ;Clear condition code
RTS PC ;Done
;Return a trans: TMAKE, TVADD, TTMUL, TINVRT
TMAKE: ;Interpreter routine.
;All that is required is to take the rot part of the first argument,
;and the vector from the second part;
MOV (R3)+,R1 ;R1 ← LOC[arg 1]
MOV (R3)+,-(SP) ;Push LOC[arg 2]
JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans]
MOV #14,R2 ;R2 ← Count of how many copies to make
TMK1: MOV (R1)+,(R0)+ ;Transfer first half of floating word
MOV (R1)+,(R0)+ ;Transfer second half of floating word
SOB R2,TMK1 ;Repeat until done
MOV (SP)+,R1 ;R1 ← LOC[arg 2]
MOV #4,R2 ;R2 ← Count of how many copies to make
TMK2: MOV (R1)+,(R0)+ ;Transfer first half of floating word
MOV (R1)+,(R0)+ ;Transfer second half of floating word
SOB R2,TMK2 ;Repeat until done
CCC ;Clear condition code.
RTS PC ;Done.
TVADD: ;Interpreter routine.
;All that is required is to take the rot part of the first argument,
;and add the vector from the first part to the second argument.
MOV (R3)+,R1 ;R1 ← LOC[arg 1]
MOV (R3)+,R2 ;R2 ← LOC[arg 2]
JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans]
MOV R3,-(SP) ;Save R3
MOV #14,R3 ;R3 ← Count of how many copies to make
TVA1: MOV (R1)+,(R0)+ ;Transfer first half of floating word
MOV (R1)+,(R0)+ ;Transfer second half of floating word
SOB R3,TVA1 ;Repeat until done
MOV #3,R3 ;R3 ← Count of how many additions to perform
TVA2: LDF (R1)+,AC0 ;AC0 ← word from trans
ADDF (R2),AC0 ; + word from vector
STF AC0,(R0)+ ;
SOB R3,TVA2 ;Repeat until done
MOV ONE,(R0)+ ;Set last word to 1.0
CLR (R0) ;
MOV (SP)+,R3 ;Restore R3
CCC ;Clear condition code.
RTS PC ;Done.
TTMUL: ;Interpreter routine
;Multiplies two transes together. Takes advantage of the fact that
;last row is 0 0 0 1.
MOV R4,-(SP) ;Save R4
MOV (R3)+,R2 ;R2 ← LOC[arg 2]
MOV (R3)+,R4 ;R4 ← LOC[arg 1]
JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans]
MOV R3,-(SP) ;Save R3
MOV #4,R1 ;Loop count for cols of answer
MOV R4,-(SP) ;Save a copy of R4
TTM2: LDF (R2)+,AC1 ;Pick up a column of arg2: First row
LDF (R2)+,AC2 ; Second row
LDF (R2)+,AC3 ; Third row
STF AC3,AC4 ; store in AC4
ADD #4,R2 ; Fourth row is zero
MOV #3,R3 ;Loop count for rows of answer
TTM1: LDF (R4),AC3 ;First col of arg 1
MULF AC1,AC3 ;
LDF 20(R4),AC0 ;Second col of arg 1
MULF AC2,AC0 ;
ADDF AC0,AC3 ;
LDF 40(R4),AC0 ;Third col of arg 1
MULF AC4,AC0 ;
ADDF AC0,AC3 ;
STF AC3,(R0)+ ;
ADD #4,R4 ;Move to next column of arg 1
SOB R3,TTM1 ;Repeat for first 3 rows of answer
CLR (R0)+ ;Last row of answer is zero
CLR (R0)+ ;
MOV (SP),R4 ;Reset R4 to point to first row of arg 1
SOB R1,TTM2 ;Repeat for all four columns of answer
LDF -20(R0),AC1 ;Add correction for last column, first row
ADDF 60(R4),AC1 ;
STF AC1,-20(R0) ;
LDF -14(R0),AC1 ;Add correction for last column, second row
ADDF 64(R4),AC1 ;
STF AC1,-14(R0) ;
LDF -10(R0),AC1 ;Add correction for last column, third row
ADDF 70(R4),AC1 ;
STF AC1,-10(R0) ;
MOV ONE,-4(R0) ;Make last col, last row get a one.
TST (SP)+ ;Pop the R4 temp
MOV (SP)+,R3 ;Restore R3
MOV (SP)+,R4 ;Restore R4
CCC ;Clear condition code
RTS PC ;Done
TINVRT: ;Interpreter routine
COMMENT ⊗ Inverts a trans. Takes advantage of fact that last row is
0 0 0 1. The result, (rot',trslat'), is defined:
rot' = transpose(rot)
trslat' = -(rot'*trslat)
⊗
MOV (R3)+,R2 ;R2 ← LOC[old trans], travels down the whole trans
JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans] + 4*interation number
MOV R3,-(SP) ;Save R3
MOV R4,-(SP) ;Save R4
MOV R0,R3 ;R3 ← LOC[new trans] + 20*interation number
MOV R2,R4 ;R4 ← LOC[old trans], stays constant
MOV #3,R1 ;Three columns to do
TINV1: ;Transpose a column, multiplying by the translation
CLRF AC1 ;Cumulative product
LDF (R2)+,AC0 ;Take from the source rotation
STF AC0,(R0) ; into the transpose,
MULF 60(R4),AC0 ;
SUBF AC0,AC1 ;accumulate the product.
LDF (R2)+,AC0 ;Take from the source rotation
STF AC0,20(R0) ; into the transpose,
MULF 64(R4),AC0 ;
SUBF AC0,AC1 ;accumulate the product.
LDF (R2)+,AC0 ;Take from the source rotation
STF AC0,40(R0) ; into the transpose
MULF 70(R4),AC0 ;
SUBF AC0,AC1 ;accumulate the product
MOV (R2)+,14(R3); the bottom row of zeroes
MOV (R2)+,16(R3); the bottom row of zeroes
STF AC1,60(R0) ;Place the new translation
ADD #4,R0 ;Move to next row of result
ADD #20,R3 ;Move to next column of result
SOB R1,TINV1 ;
MOV ONE,14(R3) ;The one in last row, last column
CLR 16(R3) ; "
MOV (SP)+,R4 ;Restore R4
MOV (SP)+,R3 ;Restore R3
CCC ;Clear condition code
RTS PC ;Done
;Motion: MOVE, CENTER, STOP, WHERE
.IFNZ MOVING ;If this version is supposed to be able to move
MOVE: ;Interpreter routine
MOV @LMOVE,R2 ;Set for moving operation
JMP MOVSTA ;Use the common move code
CENTER: ;Interpreter routine
MOV @LCENTER,R2 ;Set for centering operation
JMP MOVSTA ;Use the common move code
COMMENT ⊗ New version to update the frame afterwords. Assumes that
there are two arguments: a pointer to the trajectory table and a word
of mechanism bits, to help in updating the necessary variables. ⊗
MOVSTA: MOV #'π,R0 ;Whistle while you work
JSR PC,TYPCHR ;
MOV #34,R0 ;Get a device block
JSR PC,GTFREE ;
MOV R0,R1 ;R1 ← address of device block
MOV R0,-(SP) ;Save a copy on the stack
MOV @IPC(R4),R0 ;R0 ← address of coefficient list
BMPIPC ;Bump IPC
JSR PC,@R2 ;Do some kind of move (MOVE, CENTER)
MOV R0,-(SP) ;Save return info
MOV R1,-(SP) ;
MOV @IPC(R4),R2 ;R2 ← mechanism bits
BMPIPC ;Bump IPC
;Invalidate the affected device variables;
BIT #YARM,R2 ;
BEQ MOV2 ;
MOV #YAOFST,R0 ;
JSR PC,GETARG ;
CALL INVLDT,<(R0)>
MOV2: BIT #YHAND,R2 ;
BEQ MOV3 ;
MOV #YHOFST,R0 ;
JSR PC,GETARG ;
CALL INVLDT,<(R0)>
MOV3: BIT #BARM,R2 ;
BEQ MOV4 ;
MOV #BAOFST,R0 ;
JSR PC,GETARG ;
CALL INVLDT,<(R0)>
MOV4: BIT #BHAND,R2 ;
BEQ MOV5 ;
MOV #BHOFST,R0 ;
JSR PC,GETARG ;
CALL INVLDT,<(R0)>
MOV5: MOV (SP)+,R1 ;Restore return info
MOV (SP)+,R0 ;
BEQ MOV1 ;Yes
HALERR MOVERR ;No, better complain.
MOV1: MOV (SP)+,R0 ;
JSR PC,RLFREE ;Get rid of the device block
CCC ;Clear condition code
RTS PC ;Return
MOVERR: ASCIE </SERVO ERROR. ERROR BITS IN R0. DEVICE BLOCK AT (R1)/>
.IFF ;If not a moving version
MOVE:
CENTER:
HALERR MOVERR ;Can't move
BMPIPC ;Bump IPC
BMPIPC ;Bump IPC
CLR R0 ;
RTS PC ;Return
MOVERR: ASCIE </SORRY, THIS VERSION CAN'T EVEN LIFT A FINGER/>
.ENDC
STOP: ;Interpreter routine
COMMENT ⊗ Takes one argument, a set of mechanism bits. For each
one on, all the associated joints are stopped. ⊗
MOV @IPC(R4),R2 ;R2 ← mechanism bits
BMPIPC ;Bump IPC
MOV R2,R0 ;R0 ← mech bits
JSR PC,TABOFS ;R0 ← table offset
BIT #AHAND,R2 ;A hand?
BNE STOP1 ;Yes
MOV #6,R1 ;R1 ← count of joints
BR STOP2 ;
STOP1: MOV #1,R1 ;R1 ← count of joints
STOP2: MOV @LDVCPTR(R0),R2 ;R2 ← device block pointer for this servo
BEQ STOP3 ;If any
BIS #100000,(R2);Stop this device.
STOP3: SOB R1,STOP2 ;Repeat
CCC ;Clear condition code
RTS PC ;Done
WHERE: ;Interpreter routine
COMMENT ⊗ One argument: The mechanism bits. Puts value of that
mechanism on the stack. Only one mechanism at a time, please! ⊗
MOV @IPC(R4),R2 ;Mechanism bits
BMPIPC ;Bump IPC
BIT #AHAND,R2 ;A hand?
BNE MCHV1 ;No.
JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans]
BR MCHV2 ;
MCHV1: JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar]
MCHV2: MOV LTHPTR,R1 ;
JSR PC,@LUPDATE ;
CCC ;Clear condition code
RTS PC ;Done
;Condition monitors: CMMAK
.IFNZ ONMONS
COMMENT ⊗ This is the second version of condition monitors (here
refered to as c-m's). Hardware-type c-m's are still not ready. The
checker and the body are the same job in this version; before 10/2/75
they were seperate. The basic operations are Creation, Enabling,
Disabling, Destruction. Creation causes a c-m control block to be
set up, and pointed to by the c-m variable. This block has the
following fields: ⊗
II == 0
XX CMSEVT ;The event used to awaken the tester upon enabling
XX CMTEVT ;The event for which this c-m tests, if any
XX CMFORC ;The FMCB needed, if any, for calculating forces
XX CMSTAT ;Status bits for the c-m
CMENB == 1 ;set => enabled
CMDES == 2 ;set => to be destroyed
CMCBSZ == II/2 ;Length in words of a c-m control block.
COMMENT ⊗ The once-only code of the c-m is sprouted at priority 3 (it
is an interpreter), and after initialization, it waits for the
gronking event CMSEVT. Enabling signals the event CMSEVT and sets
the enabled bit in CMSTAT. Disabling resets the enabled bit, and the
c-m will wait on the CMSEVT for future action. As long as the c-m is
enabled, it periodically wakes up, checks its status bits. If the
enable bit is reset, the c-m waits for CMSEVT. Else it checks the
condition. If it is satisfied, the c-m disables itself and
proceeds to the conclusion and level 1. (The conclusion should reset
itself to level 0 after all critical activity has been accomplished.)
Otherwise, it reschedules itself. If the destroy bit should ever be
set in CMSTAT, then the c-m will destroy the event CMSEVT. Then
it will reclaim the c-m control block and will dismiss, never to
return. (The pointer to the c-m in the environment should be zeroed
by the destroying angel.). ⊗
CMMAK: ;Interpreter routine
COMMENT ⊗ Takes three arguments, the offset of the nascent c-m, the
level-offset of the event that this monitor is to wait on, if any,
and the IPC of the c-m code. ⊗
MOV @IPC(R4),R2 ;R2 ← offset
BMPIPC ;Bump IPC
ADD ENV(R4),R2 ;R2 ← Pointer into environment
TST (R2) ;Already something there?
BEQ CMMK1 ;
HALERR CMMMSG ;Yes. complain.
;Make a c-m control block
CMMK1: MOV #CMCBSZ,R0 ;
JSR PC,GTFREE ;R0 ← LOC[c-m control block]
MOV R0,(R2) ;Stuff into environment
EVMAK ;
MOV (SP)+,CMSEVT(R0) ;Make an event for CMSEVT
CLR CMSTAT(R0) ;Disabled, undestroyed
CLR CMTEVT(R0) ;Not necessarily ON <event> DO
MOV R0,-(SP) ;Save LOC[c-m control block]
MOV @IPC(R4),R0 ;R0 ← level-offset of event this c-m waits for.
BMPIPC ;Bump IPC
TST R0 ;If any
BEQ CMMK2 ;
JSR PC,GETARG ;R0 ← LOC[environment location of event]
MOV (SP),R1 ;R1 ← LOC[c-m control block]
MOV (R0),CMTEVT(R1) ;Put the CMTEVT in the c-m control block.
;Prepare the c-m job
CMMK2: MOV @IPC(R4),R0 ;R0 ← IPC of c-m code
BMPIPC ;Bump IPC
CLR R1 ;C-m's do not expire with events
JSR PC,SPAWN ;R0 ← process control block for c-m
MOV PDBR4-PDBSTA(R0),R2;R2 ← PR4 = LOC[c-m's interpeter status block]
MOV (SP)+,CMCB(R2);Stuff CMCB of the c-m
FORK R0,#INTERP,#3;Cause the c-m to be started. It will go into wait.
CCC ;Clear condition code
RTS PC ;Done
CMMMSG: ASCIE </CMMAK: WILL CREATE EXISTENT CONDITION MONITOR/>
; CMENBL, CMDSBL, CMDEST, CMTRIG, CMSKED, CMUNCR
CMNEMS: ASCIE </TRYING TO TREAT NON-EXISTENT EVENT/>
CMENBL: ;Interpeter routine
; One argument, a level-offset pair for the c-m to enable.
MOV @IPC(R4),R0 ;R0 ← level-offset
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← pointer into environment
MOV (R0),R0 ;R0 ← pointer to c-m control block.
BEQ CMDERR ;If none, then error
BIS #CMENB,CMSTAT(R0) ;Set the enable bit
EVSIG CMSEVT(R0) ;Gronk the c-m
CCC ;Clear condition code
RTS PC ;Done
CMEERR: HALERR CMNEMS ;
SCC ;Set condition code
RTS PC ;
CMDSBL: ;Interpreter routine
; One argument, a level-offset pair for the c-m to disable.
MOV @IPC(R4),R0 ;R0 ← level-offset
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← pointer into environment
MOV (R0),R0 ;R0 ← pointer to c-m control block.
BEQ CMDERR ;If none, then error
BIC #CMENB,CMSTAT(R0) ;Clear the enable bit
CCC ;Clear condition code
RTS PC ;Done
CMDERR: HALERR CMNEMS ;
SCC ;Set condition code
RTS PC ;
CMDEST: ;Interpreter routine
COMMENT ⊗ Argument list. Each is an offset for the c-m to destroy.
The list is terminated with a zero entry. ⊗
MOV @IPC(R4),R0 ;R0 ← offset
BEQ CMDS1 ;If 0, then done
BMPIPC ;Bump IPC
ADD ENV(R4),R0 ;R0 ← pointer into environment
MOV (R0),R1 ;R1 ← LOC[c-m control block]
BEQ CMDSER ;If none, then error
BIS #CMDES,CMSTAT(R1) ;Set the destroy bit
EVKIL CMSEVT(R1);Destroy the event. That ought to wake him up!
CLR (R0) ;Remove c-m from environment
BR CMDEST ;Go do the next one.
CMDS1: BMPIPC ;Bump IPC the last time
CCC ;Clear condition code
RTS PC ;Done
CMDSER: HALERR CMNEMS ;
SCC ;Set condition code
RTS PC ;
CMTRIG: ;Interpeter routine
COMMENT ⊗ Should be executed only from a c-m. Sets the priority to 1
and disables the checker. ⊗
MOV CMCB(R4),R0 ;
CMTR1: EVTST CMSEVT(R0);Eat all signals enabling the checker.
BCC CMTR1 ;
BIC #CMENB,CMSTAT(R0) ;Clear the enable bit
MOV PCB(R4),R0 ;
CLR 2(R0) ;Clear word 1 of process control block to reset nominal
; priority to 0.
SETPRI #1 ;Set the priority to 1
TST (SP)+ ;Discard old priority
CCC ;Clear condition code
RTS PC ;Done
CMSKED: ;Interpreter routine
COMMENT ⊗ Goes to sleep a while (currently, 100 milliseconds). Upon
awakening, checks the status bits of this checker, and either
dismisses, waits, or returns. ⊗
SETPRI #3 ;In case the conclusion left it at 1 or 0.
TST (SP)+ ;Flush old priority
MOV @IPC(R4),-(SP) ;Waiting interval
BMPIPC ;Bump IPC
SLEEP ;Sleep a while
MOV CMCB(R4),R0 ;R0 ← c-m control block
CMSK4: BIT #CMDES,CMSTAT(R0) ;Destroy bit set?
BEQ CMSK1 ;No
EVKIL CMSEVT(R0);Yes. Kill the triggering event.
CMSK3: JSR PC,RLFREE ;Return the c-m control block
JMP TERMINATE ;Use the interpeter terminate routine.
CMSK1: BIT #CMENB,CMSTAT(R0) ;Enable bit set?
BNE CMSK2 ;Yes.
EVWAIT CMSEVT(R0);No. Wait until signaled by the enabler
BCS CMSK3 ;If the enabling event died, so must we.
BR CMSK4 ;Else start from the awakening point.
CMSK2: MOV CMTEVT(R0),R1 ;R1 ← event to test for
BEQ CMSK5 ;If any
EVWAIT R1 ;Wait for event to happen
BIT #CMENB,CMSTAT(R0) ;Still enabled?
BNE CMSK5 ;Yes. May exit.
EVSIG R1 ;Oops, we were disabled! Resignal the event.
BR CMSK4 ;And try again.
CMSK5: CCC ;Clear condition code
RTS PC ;Done
CMUNCR: ;Interpreter routine.
COMMENT ⊗ Used in body of c-m. Starts uncritical section. ⊗
MOV PCB(R4),R0 ;
CLR 2(R0) ;Clear word 1 of process control block to reset nominal
; priority to 0.
SETPRI #0 ;Set the priority to 0
TST (SP)+ ;Flush old priority
CCC ;Clear condition code
RTS PC ;Done
.ENDC ; End of the ONMON material
;Force condition monitors. Data structures. TABOFS, FMBLK, MAKFORCE, DESFORCE
COMMENT ⊗ Certain tables are available via COMTAB entries. LERRPTR
points to the table ERRPTR of 16 words, one for each servo, which
points at the current error torques. LTHPTR points at the table THPTR
of 16 words, one for each servo, which points at the current joint
angles. ⊗
; Mechanism bits.
YARM == 1
YHAND == 2
BARM == 4
BHAND == 10
ANARM == YARM + BARM
AHAND == YHAND + BHAND
; Table offsets for various mechanisms.
OFYARM == 0
OFYHAND == 6*2
OFBARM == 7*2
OFBHAND == 15*2
; Environment offsets for the various mechanisms
YAOFST == 10
YHOFST == 12
BAOFST == 14
BHOFST == 16
; Environment offsets for the calculators of those mechanisms
YACOFS == 20
YHCOFS == 22
BACOFS == 24
BHCOFS == 26
TABOFS:
COMMENT ⊗ R0 = Mechanism bit. Returns table offset (in bytes) in R0.
For example, if the mechanism is BARM, the OFBARM is returned. ⊗
BIT #YARM,R0 ;Is it this mechanism?
BEQ TABOF1 ;No
MOV #OFYARM,R0 ;Yes. Load up proper offset
RTS PC ; and return.
TABOF1: BIT #YHAND,R0 ;Is it this mechanism?
BEQ TABOF2 ;No
MOV #OFYHAND,R0 ;Yes. Load up proper offset
RTS PC ; and return.
TABOF2: BIT #BARM,R0 ;Is it this mechanism?
BEQ TABOF3 ;No
MOV #OFBARM,R0 ;Yes. Load up proper offset
RTS PC ; and return.
TABOF3: BIT #BHAND,R0 ;Is it this mechanism?
BEQ TABOF4 ;No
MOV #OFBHAND,R0 ;Yes. Load up proper offset
RTS PC ; and return.
TABOF4: HALERR TABMES ;Illegal
CLR R0 ;
RTS PC ;
TABMES: ASCIE </ILLEGAL MECHANISM/>
; Force monitor block (FMBLK)
II == 0
FMFOMO == II ;Force - moment array. 20 words.
;WORD 0,0 force component in X direction
;WORD 0,0 ditto for Y
;WORD 0,0 Z
;WORD 40200,0 (1.0) scaling factor, not used
;WORD 0,0 moment component in X direction
;WORD 0,0 Y
;WORD 0,0 Z
;WORD 40200,0 1.0
II == II + 40
FMRETO == II ;Reaction - torque array. 14 words.
II == II + 30
FMJOAN == II ;Joint angle array. 14 words.
II == II + 30
FMMECH == II ;Arm involved: mechanism bits
II == II + 2
FMSCAL == II ;Scale factor (sum of squares of RETO)
II == II + 4
FMMODE == II ;Mode bits
FMKIL == 2 ;set if this FM should go away.
FMBEX == 4 ;set if background job
; (fills reaction-torque array) exists
FMFEX == 10 ;set by GETFORCE, reset by MAKRT
II == II + 2
FMSIZ == II/2 ;Length in words of force monitor block
MAKFORCE: ;Interpreter routine
COMMENT ⊗ Prepares the force variable needed to compute forces. The
offset is the first argument, and the mechanism number is the second
argument. Sets the environment pointing to a new force monitor
block, whose force-moment array it fills from the two top elements of
the stack, which are then popped: the first is the force vector, the
second is the moment vector. These are both in hand coordinates. This
routine does not load the reaction-torque array or the joint angle
array. ⊗
MOV #FMSIZ,R0 ;
JSR PC,GTFREE ;R0 ← LOC[new fmblock]
CLR FMMODE(R0) ;Reset all mode bits
MOV @IPC(R4),R1 ;R1 ← offset
BMPIPC ;Bump IPC
ADD ENV(R4),R1 ;R1 ← LOC[place in environment]
MOV R0,(R1) ;Stow away the pointer to the new fmblock
MOV @IPC(R4),FMMECH(R0) ;Stow away the mechanism in the new fmblock
BMPIPC ;Bump IPC
MOV (R3)+,R1 ;R1 ← LOC[moment vector]
MOV (R3)+,R2 ;R2 ← LOC[force vector]
ADD #FMFOMO,R0 ;R0 ← LOC[force-moment vector]
MOV R3,-(SP) ;Save R3
MOV #6,R3 ;R3 ← count: how many words to transfer
MAKFC1: MOV (R2)+,(R0)+ ;transfer force vector
SOB R3,MAKFC1 ;repeat
MOV ONE,(R0)+ ;
CLR (R0)+ ;
MOV #6,R3 ;R3 ← count: how many words to transfer
MAKFC2: MOV (R1)+,(R0)+ ;transfer moment vector
SOB R3,MAKFC2 ;repeat
MOV ONE,(R0)+ ;
CLR (R0) ;
MOV (SP)+,R3 ;Restore R3
CCC ;Clear condition code
RTS PC ;Return
DESFORCE: ;Interpreter routine
COMMENT ⊗ One argument: the level-offset of the force block to
destroy. Reclaims the space. If anyone was using it, tough.
Currently nothing is done to inform anyone that it is going away. ⊗
MOV @IPC(R4),R0 ;R0 ← level-offset
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[environment point]
MOV R0,R2 ;For safekeeping
MOV (R0),R0 ;R0 ← LOC[fm control block]
BEQ DESF1 ;If any
CLR (R2) ;Remove mention in the environment
BIS #FMKIL,FMMODE(R0) ;Set the destroy bit.
CCC ;Clear condition code
RTS PC ;Done
DESF1: HALERR DESMSG ;Complain
SCC ;Set condition code
RTS PC ;Done
DESMSG: ASCIE </CANT DESTROY NON-EXISTENT FORCE MONITOR/>
; GETFORCE, MAKRT
GETFORCE: ;Interpreter routine
COMMENT ⊗ One argument, the level-offset of the force variable, which
points to the force monitor block. It is assumed that the reaction
torque array is already prepared. Calculates the current force on
the arm and places it on the stack. ⊗
MOV @IPC(R4),R0 ;R0 ← Level-offset
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[fmblock]]
MOV (R0),R2 ;R2 ← LOC[fmblock]
BEQ GTFRC4 ;If any
CLRF AC0 ;AC0 is the result force. Set to 0.
BIS #FMFEX,FMMODE(R2) ;Imply that we are still awake.
BIT #FMBEX,FMMODE(R2) ;Is there a MAKRT job?
BNE GTFRC6 ;Yes.
;Make a job for the MAKRT routine. Put LOC[fmblock] in its R0.
BIS #FMBEX,FMMODE(R2) ;Say that the MAKRT job exists.
MOV #210,R0 ;Room for process descriptor
JSR PC,GTFREE ;R0 ← LOC[new process descriptor]
MOV R2,PDBR0(R0) ;Put LOC[fmblock] in its new R0
MOV R0,PDBR1(R0) ;Put LOC[PCB] in its new R1
MOV #UFPUSE+UGRSAV,PDBSTA(R0);Use floating point, use saved registers.
MOV #420,UPDLEN(R0) ;Length of PCB
;do something about the stack pointer
MOV #MAKRT,PDBPC(R0) ;Store away the new PC
FORK R0,#MAKRT,#3 ;Cause the new process to be started.
GTFRC6: MOV FMMECH(R2),R0 ;R0 ← mechanism
JSR PC,TABOFS ;R0 ← offset into joint error table
ADD LERRPTR,R0 ;R0 ← LOC[proper place in error torque]
MOV R2,R1 ;
ADD #FMRETO,R1 ;R1 ← LOC[reaction torque array]
BIT #AHAND,FMMECH(R2) ;Is it a hand?
BEQ GTFRC1 ;No
MOV #1,R2 ;Yes, R2 ← 2 ← count of joints
BR GTFRC2 ;
GTFRC1: MOV #6,R2 ;R2 ← 6 ← count of joints
GTFRC2: LDF (R1)+,AC1 ;AC1 ← reaction torque
MULF @(R0)+,AC1 ; * joint error
ADDF AC1,AC0 ;cumulate
SOB R2,GTFRC2 ;repeat
DIVF FMSCAL(R2),AC0 ;Normalise
GTFRC3: JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store answer
CCC ;Clear condition code
RTS PC ;Return
GTFRC4: HALERR GTFMES ;Complain
SCC ;Set condition code
RTS PC ;Return
GTFMES: ASCIE </NO FORCE BLOCK/>
MAKRT:
COMMENT ⊗ This is a separate job which periodically reestablishes the
reaction torque array and the scale factor for a fmblock. When first
called, the location of the fmblock is in R0, and the location of the
PCB for the process is in R1. Makes sure that the force is still
needed (that is, that the FMKIL bit is off and the FMFEX is on) and
then sets up the array. Sleeps for half a second and tries it again.
If the FMKIL is on, then the fmblock and PCB are returned to free
storage and the process terminates. If FMFEX is off, then FMBEX is
turned off as well, the PCB is returned to free storage, and the
process terminates. ⊗
MOV R1,-(SP) ;Save the PCB address
MOV R0,R4 ;R4 ← LOC[fmblock]
MAKRT5: BIT #FMKIL,FMMODE(R4) ;Kill bit set?
BNE MAKRT3 ;Yes.
BIT #FMFEX,FMMODE(R4) ;Has GETFORCE been called recently?
BNE MAKRT4 ;Yes.
BIC #FMBEX,FMMODE(R4) ;No; say we are leaving.
BR MAKRT6 ;Leave
MAKRT4: BIC #FMFEX,FMMODE(R4) ;Reset the recency bit.
MOV FMMECH(R4),R0 ;R0 ← mechanism
JSR PC,TABOFS ;R0 ← offset into joint error table
ADD LTHPTR,R0 ;R0 ← LOC[proper place in joint ang table]
MOV R4,R1 ;
ADD #FMJOAN,R1 ;R1 ← LOC[joint angle list in fmblock]
BIT #AHAND,FMMECH(R4) ;Is it a hand?
BEQ MAKRT1 ;No
MOV #1,R3 ;Yes, R3 ← 1 ← words to transfer
BR MAKRT2 ;
MAKRT1: MOV #6,R3 ;R3 ← 6 ← words to transfer
MAKRT2: LDF @(R0)+,AC0 ;Transfer current joint angle
STF AC0,(R1)+ ;
SOB R3,MAKRT2 ;repeat
MOV R4,R0 ;
ADD #FMFOMO,R0 ;R0 ← LOC[force-moment array]
MOV R4,R1 ;
ADD #FMRETO,R1 ;R1 ← LOC[reaction torque array to be returned]
MOV FMMECH(R4),R3 ;R3 ← mechanism number
MOV R4,R2 ;
ADD #FMJOAN,R2 ;R2 ← LOC[current joint angles]
JSR PC,@LFORCE ;This actually fills the reaction torque array
MOV R4,R0 ;
ADD #FMRETO,R0 ;R0 ← LOC[reaction-torque array]
CLRF AC0 ;AC0 ← sum of the squares
BIT #AHAND,FMMECH(R4) ;Is it a hand?
BEQ MAKRT7 ;No
MOV #1,R3 ;Yes, R3 ← 1 ← words to sum
BR MAKRT8 ;
MAKRT7: MOV #6,R3 ;R3 ← 6 ← words to sum
MAKRT8: LDF (R0),AC1 ;compute sum of squares
MULF (R0)+,AC1 ;
ADDF AC1,AC0 ;
SOB R3,MAKRT8 ;
STF AC0,FMSCAL(R4) ;Store the sum of the squares
SLEEP #1000 ;Sleep half a second
BR MAKRT5 ;Do it again
MAKRT3: MOV R4,R0 ;R0 ← LOC[fmblock]
JSR PC,RLFREE ;Release the fmblock
MAKRT6: MOV (SP)+,R0 ;R0 ← LOC[PCB]
JSR PC,RLFREE ;Release the PCB
DISMIS ;Go away.
;Events: MAKEVT, SIGNAL, WAITE, DESEVT;
COMMENT ⊗ Events can be created (at the beginnings of blocks is the
usual place), signaled, awaited (in the middle of a block) and
destroyed (at the end of a block). Each event is a variable, that
is, it is refered to by a level-offset pair. However, its place in
the environment does not point to a graph node, since there is no
such thing as attachment to an event. The event itself is stored in
the environment. The garbage collector marking phase had better
understand this. ⊗
MAKEVT: ;Interpreter routine
COMMENT ⊗ A list of arguments, each of which is an offset. This list
is terminated by a zero entry. For each argument, a fresh event is
created and placed in the environment at the desired offset, current
level. ⊗
MOV @IPC(R4),R0 ;R0 ← offset
BEQ MAKEV1 ;If none, done
BMPIPC ;Bump IPC
ADD ENV(R4),R0 ;R0 ← pointer into environment
EVMAK ;Make an event.
MOV (SP)+,(R0) ;Stuff it away.
BR MAKEVT ;Repeat
MAKEV1: BMPIPC ;Bump IPC
CCC ;Clear condition code.
RTS PC ;Done
SIGNAL: ;Interpreter routine. Signal the event of the level-offset pair.
MOV @IPC(R4),R0 ;R0 ← level-offset pair.
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← equivalent pointer into environment
EVSIG (R0) ;Signal that event.
CCC ;Clear condition code.
RTS PC ;Done
WAITE: ;Interpreter routine. Wait on the event of the level-offset pair.
MOV @IPC(R4),R0 ;R0 ← level-offset pair.
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← equivalent pointer into environment
EVWAIT (R0) ;Wait on that event.
BCS WAITE1 ;Return OK?
JMP TERMINATE ;The event was destroyed. I guess we should depart cleanly.
WAITE1:
CCC ;Clear condition code.
RTS PC ;Done
DESEVT: ;Interpreter routine
COMMENT ⊗ A list of arguments, each of which is an offset. This list
is terminated by a zero entry. For each argument, the event is
destroyed. ⊗
MOV @IPC(R4),R0 ;push offset
BEQ DESEV1 ;If none, done
BMPIPC ;Bump IPC
ADD ENV(R4),R0 ;R0 ← pointer into environment
EVKIL (R0) ;Kill the event
CLR (R0) ;Remove the event from the environment
BR DESEVT ;Repeat
DESEV1: BMPIPC ;Bump IPC
CCC ;Clear condition code.
RTS PC ;Done
;Debugging aids: PRINT, PRNTS
PRINT: ;Interpreter routine
MOV @IPC(R4),R0 ;R0 ← Address of string
BMPIPC ;Bump IPC
JSR PC,TYPSTR ;Type it out
CCC ;Clear condition code
RTS PC ;Done
PRNTS: ;Interpreter routine. Prints the scalar on the stack, pops
MOV #CRLFX,R0 ;
JSR PC,TYPSTR ;
MOV (R3)+,R2 ;R2 ← LOC[scalar value]
.IFNZ FLOAT
LDF R2,AC0 ;
MOV #OUTBUF,R0 ;
JSR PC,CVG ;Convert number to floating string in outbuf
MOV #OUTBUF,R0 ;
JSR PC,TYPSTR ;
.IFF
MOV (R2)+,R0 ;R0 ← first part
JSR PC,TYPOCT ;Type it
MOV #40,R0 ;
JSR PC,TYPCHR ; " "
MOV (R2),R0 ;
JSR PC,TYPOCT ;Type second part
.ENDC
CCC ;Clear condition code
RTS PC ;Done
; BREAK, NOOP, TOPAL, IOINIT
.IFZ ALAID
BREAK: ;Interpreter routine
MOV #BRKMES,R0 ;
JSR PC,TYPSTR ;
BPT ;Cause a DDT break
CCC ;Clear condition code
RTS PC ;Done
BRKMES: ASCIE </
PROGRAM BREAK/>
.ENDC
NOOP: ;Interpreter routine
CCC ;Clear condition code
RTS PC ;Done
TOPAL: ;Interpreter routine
COMMENT ⊗ Escape to PAL. JSRs to the pseudo code. That code
should return via:
MOV PC,R0
RTS PC
⊗
JSR PC,@IPC(R4) ;Fly
ADD #2,R0 ;R0 ← Proper new IPC
MOV R0,IPC(R4) ;Hope R4, R3 still OK!
RTS PC ;Done.
CSLEVT: 0 ;Console interlock event
IOINIT:
; Initialize the debugger. Leave all breakpoints as they are.
EVMAK ;
MOV (SP),CSLEVT ;
EVSIG ;Make a console interlock event
RTS PC ;
;Initialization psops: PROG
PROG:
COMMENT ⊗ Sets up the variables for each arm, with the associated
calculators. This is done by using some special-purpose pseudo-code
and setting this interpreter to work on it. ⊗
MOV IPC(R4),-(SP) ;Save the IPC.
MOV #PROGCD,IPC(R4) ;Set up a funny IPC
CALL INTERP ;Call ourselves to execute the code.
MOV (SP)+,IPC(R4) ;Restore the IPC
CCC ;Clear condition code
RTS PC ;Done
PROGCD:
XMVAR ;Make the mechanism variables
YAOFST
YHOFST
BAOFST
BHOFST
0
XMEXP ;The expression for updating the YARM
0 ; no neededs (so not dependent on the mechanism)
PCDYA ; code
YACOFS ; offset of expression
XMCLC ;Make it a calculator
YACOFS ; offset of expression
YAOFST ; offset of variable
XMEXP ;The expression for updating the YHAND
0 ; no neededs (so not dependent on the mechanism)
PCDYH ; code
YHCOFS ; offset of expression
XMCLC ;Make it a calculator
YHCOFS ; offset of expression
YHOFST ; offset of variable
XMEXP ;The expression for updating the BARM
0 ; no neededs (so not dependent on the mechanism)
PCDBA ; code
BACOFS ; offset of expression
XMCLC ;Make it a calculator
BACOFS ; offset of expression
BAOFST ; offset of variable
XMEXP ;The expression for updating the BHAND
0 ; no neededs (so not dependent on the mechanism)
PCDBH ; code
BHCOFS ; offset of expression
XMCLC ;Make it a calculator
BHCOFS ; offset of expression
BHOFST ; offset of variable
XPUSH ;Put some junk on the stack
0 ;
XENDCLC ;Returns to caller, and clears the stack
PCDYA: XWHERE ;Expression for YARM
YARM ;
XENDCLC ;
PCDYH: XWHERE ;Expression for YHAND
YHAND ;
XENDCLC ;
PCDBA: XWHERE ;Expression for BARM
BARM ;
XENDCLC ;
PCDBH: XWHERE ;Expression for BHAND
BHAND ;
XENDCLC ;
;BUGS
COMMENT ⊗
⊗